home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / rex.lha / rex / src / Classes.mi < prev    next >
Text File  |  1992-08-18  |  4KB  |  159 lines
  1. (* $Id: Classes.mi,v 3.2 1991/11/21 14:41:19 grosch rel $ *)
  2.  
  3. (* $Log: Classes.mi,v $
  4. Revision 3.2  1991/11/21  14:41:19  grosch
  5. fixed bug: interference of right context between constant and non-constant RE
  6. new version of RCS on SPARC
  7.  
  8. Revision 3.1  91/04/08  15:50:12  grosch
  9. release memory after use in Classes and Tree0
  10.  
  11. Revision 3.0  91/04/04  18:26:37  grosch
  12. Initial revision
  13.  
  14.  *)
  15.  
  16. (* Ich, Doktor Josef Grosch, Informatiker, March 1991 *)
  17.  
  18. IMPLEMENTATION MODULE Classes;
  19.  
  20. FROM SYSTEM    IMPORT TSIZE;
  21. FROM DynArray    IMPORT MakeArray, ExtendArray, ReleaseArray;
  22. FROM Strings    IMPORT tString, Char, Length;
  23. FROM StringMem    IMPORT GetString;
  24. FROM IO        IMPORT StdOutput, WriteC, WriteI, WriteS, WriteNl;
  25. FROM Layout    IMPORT WriteChar;
  26. FROM Sets    IMPORT tSet, MakeSet, Assign, Include, IsEqual, ForallDo, WriteSet,
  27.             Intersection, Union, Difference, Complement, ReleaseSet, IsEmpty,
  28.             IsSubset;
  29. FROM Tree0    IMPORT tTree0, Tree0Root, TraverseTree0TD, Ch, Set, String;
  30. FROM Dfa    IMPORT FirstCh, LastCh, OldLastCh, EobCh;
  31.  
  32. PROCEDURE IsInSetMem (Set: tSet): INTEGER;
  33.    VAR i : INTEGER;
  34.    BEGIN
  35.       FOR i := 1 TO SetCount DO
  36.      IF IsEqual (Set, SetMemPtr^[i].Set) THEN RETURN i; END;
  37.       END;
  38.       RETURN 0;
  39.    END IsInSetMem;
  40.  
  41. PROCEDURE CollectSets (t: tTree0);
  42.    VAR i    : CARDINAL;
  43.    VAR string    : tString;
  44.    BEGIN
  45.       CASE t^.Kind OF
  46.       | Ch    : Include (CharSet, ORD (t^.Ch.Ch));
  47.  
  48.       | Set    : IF IsInSetMem (t^.Set.Set) = 0 THEN
  49.              INC (SetCount);
  50.              IF SetCount = SetMemSize THEN
  51.             ExtendArray (SetMemPtr, SetMemSize, TSIZE (ClassInfo));
  52.              END;
  53.              MakeSet (SetMemPtr^[SetCount].Set, ORD (LastCh));
  54.              Assign (SetMemPtr^[SetCount].Set, t^.Set.Set);
  55.              Union (Unused, t^.Set.Set);
  56.           END;
  57.  
  58.       | String    : GetString (t^.String.String, string);
  59.           FOR i := Length (string) TO 1 BY -1 DO
  60.              Include (CharSet, ORD (Char (string, i)));
  61.           END;
  62.       ELSE
  63.       END;
  64.    END CollectSets;
  65.  
  66. VAR Class: CHAR;
  67.  
  68. PROCEDURE CharToClass0 (Ch: CARDINAL);
  69.    BEGIN
  70.       ToClass [CHR (Ch)] := Class;
  71.    END CharToClass0;
  72.  
  73. PROCEDURE CharToClass (Ch: CARDINAL);
  74.    BEGIN
  75.       INC (LastCh);
  76.       ToClass [CHR (Ch)] := LastCh;
  77.       ToChar [LastCh] := CHR (Ch);
  78.    END CharToClass;
  79.  
  80. PROCEDURE ComputeClasses (Blocking: BOOLEAN);
  81.    VAR i    : INTEGER;
  82.    VAR j    : CHAR;
  83.    VAR Set    : tSet;
  84.    BEGIN
  85.       OldLastCh := LastCh;
  86.       MakeSet (CharSet, ORD (LastCh));
  87.       MakeSet (Unused, ORD (LastCh));
  88.  
  89.       IF Blocking THEN
  90.      TraverseTree0TD (Tree0Root, CollectSets);
  91.      Include (CharSet, ORD (EobCh));
  92.      Union (Unused, CharSet);
  93.      Complement (Unused);
  94.       ELSE
  95.      Include (CharSet, ORD (FirstCh));
  96.      Complement (CharSet);
  97.       END;
  98.  
  99.       ClassCount := 0C;
  100.       MakeSet (ClassMemPtr^[0C], ORD (LastCh));
  101.       Assign (ClassMemPtr^[0C], CharSet);
  102.       Union (ClassMemPtr^[0C], Unused);
  103.       Complement (ClassMemPtr^[0C]);
  104.  
  105.       MakeSet (Set, ORD (LastCh));
  106.       FOR i := 1 TO SetCount DO
  107.      FOR j := 0C TO ClassCount DO
  108.         Assign (Set, SetMemPtr^[i].Set);
  109.         Difference (Set, CharSet);
  110.         Intersection (Set, ClassMemPtr^[j]);
  111.         IF NOT IsEmpty (Set) AND NOT IsEqual (Set, ClassMemPtr^[j]) THEN
  112.            INC (ClassCount);
  113.            IF ORD (ClassCount) = CARDINAL (ClassMemSize) THEN
  114.           ExtendArray (ClassMemPtr, ClassMemSize, TSIZE (tSet));
  115.            END;
  116.            MakeSet (ClassMemPtr^[ClassCount], ORD (LastCh));
  117.            Assign (ClassMemPtr^[ClassCount], Set);
  118.            Difference (ClassMemPtr^[j], Set);
  119.         END;
  120.      END;
  121.       END;
  122.       ReleaseSet (Set);
  123.  
  124.       FOR i := 1 TO SetCount DO
  125.      MakeSet (SetMemPtr^[i].Classes, ORD (ClassCount));
  126.      FOR j := 0C TO ClassCount DO
  127.         IF IsSubset (ClassMemPtr^[j], SetMemPtr^[i].Set) THEN
  128.            Include (SetMemPtr^[i].Classes, ORD (j));
  129.         END;
  130.      END;
  131.       END;
  132.  
  133.       FOR j := 0C TO ClassCount DO
  134.      Class := j;
  135.      ForallDo (ClassMemPtr^[j], CharToClass0);
  136.       END;
  137.  
  138.       LastCh := ClassCount;
  139.       ForallDo (CharSet, CharToClass);
  140.    END ComputeClasses;
  141.  
  142. PROCEDURE ReleaseSetMem;
  143.    VAR i : INTEGER;
  144.    BEGIN
  145.       FOR i := 1 TO SetCount DO
  146.      ReleaseSet (SetMemPtr^[i].Set);
  147.      ReleaseSet (SetMemPtr^[i].Classes);
  148.       END;
  149.       ReleaseArray (SetMemPtr, SetMemSize, TSIZE (ClassInfo));
  150.    END ReleaseSetMem;
  151.  
  152. BEGIN
  153.    SetMemSize := 16;
  154.    MakeArray (SetMemPtr, SetMemSize, TSIZE (ClassInfo));
  155.    SetCount := 0;
  156.    ClassMemSize := 16;
  157.    MakeArray (ClassMemPtr, ClassMemSize, TSIZE (tSet));
  158. END Classes.
  159.